Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/BASIC/RadSlider CDEF 1.5/RadSlider.CDEF

Text File | 1994-11-21 | 42.5 KB | 866 lines | [TEXT/ZBAS]

'RadSlider CDEF,  version 1.5
'Copyright © 1994 MarsSaxMan (Jonathan Durkee), Red Planet Software
'All Rights Reserved

'Permission granted to distribute this source code on a non-commercial basis *provided the file is not changed
'in any way*, including the above copyright notice. For commercial distribution, contact me for permission first.

'Jonathan Durkee
'9205 Starina Way
'Sacramento, CA  95826
'[phone]
'AOL/eWorld:   MarsSaxMan
'You can reach me at either service  through the Internet:
'[e-mail] or [e-mail]

'I'm distributing this source code in hopes that you will find it useful as an example for developing your own
'CDEFs. I don't ask anything for its use - you may include the compiled, intact RadSlider in your programs
'free of charge, and you don't even have to mention my name anywhere - but I do ask that if you use the source
'code in a CDEF of your own, that you would acknowledge my help in your Read Me or wherever appropriate.
'RadSlider is not a big, fancy program, but it still does represent a substantial investment of my time.

'In recognition of the fact that many readers of this document will not be familiar with the modern extensions
'to BASIC incorporated by FutureBASIC, the following section describes many of the less obvious commands
'and operations used in this program.

'FUNCTIONS
'FutureBasic functions must be defined before they are called (except for a work-around which is not used
'in this program). An ENTERPROC%/EXITPROC% is a function, but one that defines the main entry point
'for a code resource. Being the main procedure, it is therefore at the bottom of the file.
'Variables are declared before the function entry, between the LOCAL statement and the LOCAL FN definition.
'The LOCAL command has two modifications: CLEAR and MODE. They can be used together.
'CLEAR LOCAL causes all local vars to be set to _nil before function code is executed. LOCAL MODE means
'that all variables are assumed to be local, and no globals are allowed.
'Though FB functions can call themselves recursively, no functions in this program do so.

'VARIABLES
'All variables not explicitly defined as globals (DIM'ed before the END GLOBALS command) are assumed
'to be local to the function in which they are used. I have set the _dimmedVarsOnly compile flag to
'insure that ONLY explicitly defined variables are allowed, whether local or global. Note that this program,
'being a CDEF, uses no globals.Variables are assumed to be integers unless specified otherwise. I typically
'specify variable types anyway, so recognizing variable types shouldn't be a problem.
'variable% is an integer, variable& a long integer. variable$ is a Pascal type Str255 with leading length
'byte. variable%(index%) is an array variable, with element numbers starting at zero.

'RECORDS
'Records can be declared either by name or size in bytes. If you wanted a grafport/cgrafport
'record, you could do one of the following:
'DIM portVar.portRec
'DIM portVar.192
'I typically use the named record types because they are easier to remember, except for rectangles,
'which have no record type name. I just reserve them like this: DIM someRect.8
'If a variable points to a record (or even if it doesn't!), fields in that record (or memory area) can be
'accessed like this: pointer&.field%. This differs from ordinary records in that the "&" sign of a long
'integer is retained. The same works for handles, handle&..field%, only two periods are placed between
'the handle and the field. This is basically the same as C's -> operator.
'Records can be set equal to each other, and the entire record will be copied. For example, if you DIM'ed
' record1.recType and record2.recType, you could copy _recType bytes between them just by saying
' record1=record2. Alternatively, you can copy an arbitrary number of bytes from an address into
'any variable like this:  var;_bytes=address&. _bytes must be a constant, whether a record name, a
'constant, or just a typed-in number.

'OTHER MISCELLANEOUS STUFF
'POKE/PEEK WORD/LONG all have shorthand versions which I use instead. %addr&,val is POKE WORD
'and &addr&,val is POKE LONG. {addr&} is short for PEEK WORD, and [addr&] is PEEK LONG.
'PSTR$(addr&) function either returns the string pointed at by addr&, or puts the string you specify
'into the string pointed at by addr&, depending on the side of the equals sign it is found on.
'You'll notice I use certain named constants a lot (constant is a name with an underscore "_" before it)
'_nil = 0 of course, as does _false. _true=1, _zTrue=&FFFFFFFF (or -1), and _pTrue=&FF (or 255).

COMPILE 0,_caseInsensitive_macsBugLabels_dimmedVarsOnly_appendRes
'these compiler flags mean -
'* _caseInsensitive - somevar and SOMEVAR are treated as the same variable
'* _macsBugLabels - put MacsBug type text labels on functions
'* _dimmedVarsOnly - variables must be declared explicitly before use
'* _appendRes - append the code resource to the destination file; don't overwrite the file
RESOURCES "","APPL????","CDEF",6,"RadSlider",0
'the "6" in this line is the CDEF resource ID. Change it to whatever value you find appropriate for your program.
OUTPUT FILE "RadSlider Demo"
'place the compiled code resource into the file "RadSlider Demo", the demo app for the control

_fixedSize=23                                     'the control is a fixed size of this many pixels, either horz or vert, depending on which way the control goes
_edgeOffset=6                                     'how many pixels between the sized rect and the slider bar edge
_fillClearOffset=7                                'this many pixels in from the edge gives you the spot to clear

_outsideRoundMajor=8                              'curve values for the outside slider bar roundrect
_outsideRoundMinor=12
_insideRoundMajor=6                               'curve values for the inner roundrect
_insideRoundMinor=8

_handleRound=4                                    'rounding value for the handle roundrects
_handleEdgeOffset=4                               'how many pixels to scoot in from the left side
_handleTallEdgeOffset=6
_handleWideWidth=11                               'how many pixels wide is the wide part of the handle?
_handleTallWidth=7                                'how many pixels wide is the tall part of the handle


'part constants - used to set up the pen correctly for various parts of the control
_handleWideFrame=0
_handleTallFrame=1
_barOutsideFrame=2
_barInsideFrame=3
_barFill=4
_barClear1=5
_barClear2=6
_fillClear1=7
_fillClear2=8
_tickMarks=9
_titleText=10
_valueText=11


'varcode constants:
_useTingeColor=1                                  'use the System's tinge color for the inner fill
_drawTickMarks=2                                  'draw the tick marks along top or left of the slider
_drawValueText=4                                  'continuously update the control's current value
'_useWFont=8                                          'this supported constant is already defined...


_titleFont=3                                      'Geneva
_titleSize=9                                      '9 point text


'extra cctb constants not included in FB:
_cTingeLight=13
_cTingeDark=14

END GLOBALS

GOTO "MainEntry"                                  'jump directly to our main entry procedure; skip & get moving

"Math Calculators"                                '*********************************************************************************************

'This function calculates the pixel offset to the edge of the slider handle. This function is also used for
'tracking the mouse to determine what value it currently lies over (and thus where to jump the slider hande to).
'theControl& is the control handle; rectPtr& is a pointer to the control's rectangle. current% is the current
'value of the control. This value is passed as a parameter rather than extracted from the control record
'because the function may be used for determining which control value the mouse is closest to, and in
'that case the control value is in the process of being determined. orient% is a pre-calculated value
'which will always be equal to _horz or _vert, depending on the currentorientation of the slider. This
CLEAR LOCAL MODE
DIM handleOffset%
DIM contrlRect.8
LOCAL FN handleOffset(theControl&,rectPtr&,current%,orient%)
  contrlRect;8=rectPtr&                           'copy out the rectangle to draw the control in
  LONG IF orient%=_horz
    handleOffset%=((contrlRect.right%-_handleEdgeOffset-contrlRect.left%-_handleEdgeOffset-_handleWideWidth)*current%)/(theControl&..contrlMax%-theControl&..contrlMin%)
  XELSE
    handleOffset%=((contrlRect.bottom%-_handleEdgeOffset-contrlRect.top%-_handleEdgeOffset-_handleWideWidth)*(theControl&..contrlMax%-current%))/(theControl&..contrlMax%-theControl&..contrlMin%)
  END IF
END FN=handleOffset%

'Function is included here because it's used in 3 different places... appropriate use for a function, eh?
'it offsets the given rectangle (which it assumes is the control rectangle) if the control has text.
LOCAL FN skoogieRectForTitle(theControl&,rectPtr&,dontSwapFont%)
  'if we have a control title, we must adjust the control rect accordingly so the control tracking is correct.
  LONG IF PEEK([theControl&]+_contrlTitle)>0      'make sure there is text in the control's title str
    LONG IF dontSwapFont%=_false
      CALL TEXTFONT(_titleFont)                   'Geneva 9 point text for us, please
      CALL TEXTSIZE(_titleSize)
      CALL TEXTFACE(0)                            'plain text
      CALL TEXTMODE(_srcCopy)                     'wipe out everything underneath
    END IF
    LONG IF PEEK([theControl&]+_contrlTitle+1)<>13
      'if the first character is NOT a return, then the title goes along the top of the slider rect.
      rectPtr&.top%=rectPtr&.top%+USR FONTHEIGHT
      'this forces the slider to be centered further down in its rectangle
    XELSE
      rectPtr&.bottom%=rectPtr&.bottom%-USR FONTHEIGHT
      'scrunches the slider up to fit the text underneath
    END IF
  END IF
END FN

"Pixel Utilities"                                 '****************************************************************************************************************************

CLEAR LOCAL MODE
DIM pixDepth%,gDevHndl&
LOCAL FN getPixelDepth(@rectPtr&)
  'function reports the pixel depth of the main monitor
  LONG IF {_ROM85} AND &C000                      'running on a Mac Plus?
    pixDepth%=1                                   'then bit depth is automatically 1
    'Plus does not support FN GETMAINDEVICE call so we don't bother even calling it
    'because the Plus and below only have black and white graphics anyway
  XELSE
    gDevHndl& = FN GETMAXDEVICE(#rectPtr&)        'get main monitor, the one with the menu bar
    pixDepth%= {[[[gDevHndl&]+_gdpMap]]+_pmPixelSize}
    'get main graphics device, then extract the pixmap pixel size out of it
  END IF
END FN=pixDepth%

CLEAR LOCAL MODE
DIM thePattern.8
LOCAL FN setGrayPattern
  'sets the pen to gray pattern, and if color, to 25%/53% gray color
  thePattern.top%=43605
  thePattern.left%=43605
  thePattern.bottom%=43605
  thePattern.right%=43605
  CALL PENPAT(thePattern)
END FN

CLEAR LOCAL MODE
DIM theColor.RGBColor
LOCAL FN setGrayColor
  'sets the foreground color to dark gray & the background color to light gray
  theColor.red%=49152
  theColor.green%=49152
  theColor.blue%=49152
  CALL RGBBACKCOLOR(theColor.red%)
  theColor.red%=31129
  theColor.green%=31129
  theColor.blue%=31129
  CALL RGBFORECOLOR(theColor.red%)
END FN

CLEAR LOCAL MODE
DIM theColor.RGBColor
LOCAL FN setNormalColors
  'sets the foreground color to normal black and white
  theColor.red%=65535
  theColor.green%=65535
  theColor.blue%=65535
  CALL RGBBACKCOLOR(theColor.red%)
  theColor.red%=0
  theColor.green%=0
  theColor.blue%=0
  CALL RGBFORECOLOR(theColor.red%)
END FN

LOCAL FN setColors(forePtr&,backPtr&)
  'function sets foreground & background colors passed by address
  CALL RGBFORECOLOR(#forePtr&)
  CALL RGBBACKCOLOR(#backPtr&)
END FN

CLEAR LOCAL MODE
DIM aux&,ccTab&                                   'handles for  getting aux ctl colors
DIM ccTabPtr&                                     'pointer to color table block
DIM maxIndex%,crntIndex%
DIM osErr
LOCAL FN getAuxCtlColor(theControl&,theColor%,@destPtr&)
  osErr=FN GETAUXCTL(theControl&,aux&)            'get the aux handle to this control
  LONG IF aux&<>_nil                              'verify the handle is valid
    ccTab&=aux&..acCTable&                        'get the color table for this control
    LONG IF ccTab&
      maxIndex%={[ccTab&]+_ctSize}                'how many entries does this color table hold?
      FOR crntIndex%=0 TO maxIndex%
        ccTabPtr&=[ccTab&]+_ctTable+(crntIndex%*_ctRec)
        LONG IF {ccTabPtr&}=theColor%
          'did we get the color we were looking for? alright, then copy it to our destination.
          %destPtr&+_red,{ccTabPtr&+2}
          %destPtr&+_green,{ccTabPtr&+4}
          %destPtr&+_blue,{ccTabPtr&+6}
        END IF
      NEXT crntIndex%
    XELSE                                         '{ccTab& is not valid}
      FN setNormalColors                          'if we can't get custom colors, set to normal colors instead.
    END IF
  XELSE                                           '{aux& is not valid}
    FN setNormalColors
  END IF
END FN

CLEAR LOCAL MODE
DIM foreColor.RGBColor,backColor.RGBColor
DIM tempColor&                                    'used for calculating the 50% blend in the center of the slider panel
LOCAL FN setPartColor(theControl&,@oldForePtr&,@oldBackPtr&,varCode%,whichPart%)
  'function sets the color for the specified part. If the control has a color table, the color table is used.
  'If not, the standard black foreground/white background/gray fill colors are used. However if varCode
  'has its useTingeColor bit set, that overrides the color table, and the standard tinge colors are used.
  'forecolor is set up to black already - leave it alone
  backColor.red%=-1:backColor.green%=-1:backColor.blue%=-1'set this to white default

  SELECT whichPart%
    CASE _handleWideFrame                         'the "wide" part of the draggable handle
      FN getAuxCtlColor(theControl&,_cThumbColor,backColor.red%)
      FN setColors(@foreColor.red%,@backColor.red%)
    CASE _handleTallFrame                         'the tall, thin part of the sliding slider handle
      FN getAuxCtlColor(theControl&,_cThumbColor,backColor.red%)
      FN setColors(@foreColor.red%,@backColor.red%)
    CASE _barOutsideFrame                         'the outside of the slider's main body
      FN getAuxCtlColor(theControl&,_cFrameColor,foreColor.red%)
      FN setColors(@foreColor.red%,@backColor.red%)
    CASE _barInsideFrame                          'frame inside the bar
      FN getAuxCtlColor(theControl&,_cFrameColor,foreColor.red%)
      FN setColors(@foreColor.red%,@backColor.red%)
    CASE _barFill                                 'patterned fill within the slider bar
      LONG IF (varCode% AND _useTingeColor)<>_nil
        'if we're supposed to use the tinge colors, then do so
        FN getAuxCtlColor(theControl&,_cTingeDark,foreColor.red%)
        FN getAuxCtlColor(theControl&,_cTingeLight,backColor.red%)
        FN setColors(@foreColor.red%,@backColor.red%)
      XELSE
        'no, don't use tinge colors; use the body color instead
        FN getAuxCtlColor(theControl&,_cBodyColor,foreColor.red%)
        LONG IF foreColor.red%<>-1 AND foreColor.green%<>-1 AND foreColor.blue%<>-1
          'only use the body color if it is not solid white - that is the default. We don't want solid
          'white, because that doesn't show up; so we use the gray color instead.
          %@tempColor&+2,foreColor.red%           'put it in, unsigned
          tempColor&=65535-((65535-tempColor&)/2)
          backColor.red%=FN LOWORD(tempColor&)
          %@tempColor&+2,foreColor.green%         'put it in, unsigned
          tempColor&=65535-((65535-tempColor&)/2)
          backColor.green%=FN LOWORD(tempColor&)
          %@tempColor&+2,foreColor.blue%          'put it in, unsigned
          tempColor&=65535-((65535-tempColor&)/2)
          backColor.blue%=FN LOWORD(tempColor&)
          FN setColors(@foreColor.red%,@backColor.red%)
        XELSE
          FN setGrayColor
        END IF
      END IF
    CASE _barClear1                               'the clear part on the top of the slider bar
      FN setColors(oldForePtr&,oldBackPtr&)
    CASE _barClear2                               'the clear part on the bottom of the slider bar
      FN setColors(oldForePtr&,oldBackPtr&)
    CASE _fillClear1                              'the 1-pixel line between the edge of the slider bar and the inner fill (top)
      FN setColors(oldForePtr&,oldBackPtr&)
    CASE _fillClear2                              '1-pixel line between the edge of the slider bar and the inner fill (bottom)
      FN setColors(oldForePtr&,oldBackPtr&)
    CASE _tickMarks
      FN getAuxCtlColor(theControl&,_cFrameColor,foreColor.red%)
      FN setColors(@foreColor.red%,oldBackPtr&)
    CASE _titleText,_valueText
      FN getAuxCtlColor(theControl&,_cTextColor,foreColor.red%)
      FN setColors(@foreColor.red%,oldBackPtr&)
  END SELECT
END FN

"Constructors/Deconstructors"                     '************************************************************************************************************************

LOCAL FN makeControlRegion(theControl&)
  theControl&..contrlData&=FN NEWRGN
END FN

LOCAL FN killControlRegion(theControl&)
  IF theControl&..contrlData& THEN CALL DISPOSERGN(theControl&..contrlData&)
END FN


"Draw/Click"                                      '*********************************************************************************************************************************

`       dcb.p   'Copyright © 1994 Jonathan E. Durkee'
'this installs my copyright notice directly into the compiled code resource

CLEAR LOCAL MODE
DIM tickOffset%,tickBox.8
DIM numTicks%,currentTick%
DIM handleOffset%
LOCAL FN drawTickMarks(theControl&,@contrlRectPtr&,orient%)
  'calculates and draws the tick marks for the slider.
  'If horizontal, draws them sticking up along the top. If vertical, draws them on the left side.
  FOR currentTick%=theControl&..contrlMin% TO theControl&..contrlMax%
    tickBox;8=contrlRectPtr&
    LONG IF orient%=_horz
      tickBox.left%=tickBox.left%+_handleEdgeOffset+(_handleWideWidth/2)
      tickBox.right%=tickBox.left%+1
      tickBox.bottom%=tickBox.top%+_edgeOffset
      tickBox.top%=tickBox.top%+2
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,currentTick%,_horz)
      CALL OFFSETRECT(tickBox.top%,handleOffset%,0)
    XELSE
      tickBox.top%=tickBox.top%+_handleEdgeOffset+(_handleWideWidth/2)
      tickBox.bottom%=tickBox.top%+1
      tickBox.right%=tickBox.left%+_edgeOffset
      tickBox.left%=tickBox.left%+2
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,currentTick%,_vert)
      CALL OFFSETRECT(tickBox.top%,0,handleOffset%)
    END IF
    CALL FRAMERECT(tickBox.top%)
  NEXT currentTick%
END FN

CLEAR LOCAL MODE
DIM theRect.8,contrlRect.8
DIM handleOffset%
DIM 7 valueText$                                  'used for calculating the value text offset thing
LOCAL FN calcHorzRect(theControl&,contrlRectPtr&,destRectPtr&,whichRect%)
  contrlRect;8=contrlRectPtr&
  SELECT whichRect%
    CASE _handleWideFrame                         'the "wide" part of the draggable handle
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.left%+_handleEdgeOffset
      theRect.right%=theRect.left%+_handleWideWidth
      INC(theRect.top%):DEC(theRect.bottom%)
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,theControl&..contrlValue%,_horz)
      CALL OFFSETRECT(theRect.top%,handleOffset%,0)
    CASE _handleTallFrame                         'the tall, thin part of the sliding slider handle
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.left%+_handleTallEdgeOffset
      theRect.right%=theRect.left%+_handleTallWidth
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,theControl&..contrlValue%,_horz)
      CALL OFFSETRECT(theRect.top%,handleOffset%,0)
    CASE _barOutsideFrame                         'the outside of the slider's main body
      'now draw the roundrects:
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.top%+_edgeOffset
      theRect.bottom%=theRect.bottom%-_edgeOffset
    CASE _barInsideFrame
      theRect;8=contrlRectPtr&
      CALL INSETRECT(theRect.top%,2,8)            'groan... ugghh.... why did I do this?
    CASE _barFill
      theRect;8=contrlRectPtr&
      CALL INSETRECT(theRect.top%,3,9)            'this is equally equivalent ugly code
    CASE _barClear1
      theRect;8=contrlRectPtr&
      theRect.bottom%=theRect.top%+_edgeOffset
    CASE _barClear2
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.bottom%-_edgeOffset
    CASE _fillClear1                              'the 1-pixel line between the edge of the slider bar and the inner fill (top)
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.top%+_fillClearOffset
      theRect.bottom%=theRect.top%+1
      theRect.left%=theRect.left%+_handleEdgeOffset
      theRect.right%=theRect.right%-_handleEdgeOffset
    CASE _fillClear2                              '1-pixel line between the edge of the slider bar and the inner fill (bottom)
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.bottom%-_fillClearOffset-1
      theRect.bottom%=theRect.top%+1
      theRect.left%=theRect.left%+_handleEdgeOffset
      theRect.right%=theRect.right%-_handleEdgeOffset
    CASE _titleText                               'box for the control title to go in
      'this depends on whether the control title starts with a return character or not. If it does, that
      'means the title is supposed to go underneath the slider bar. If not, it means the title is above
      'the slider bar, as normal.
      theRect;8=contrlRectPtr&
      LONG IF PEEK([theControl&]+_contrlTitle+1)<>13
        'if the control does NOT start with a return, then do the normal above-rect thing.
        theRect.top%=theRect.top%-(USR FONTHEIGHT+1)
        theRect.bottom%=theRect.top%+USR FONTHEIGHT-1
      XELSE
        theRect.top%=theRect.bottom%
        theRect.bottom%=theRect.top%+USR FONTHEIGHT'position below the slider bar
      END IF
      theRect.right%=theRect.left%+FN STRINGWIDTH(theControl&..contrlTitle$)+2
    CASE _valueText
      'this is used to draw the control's current value on the right side of the slider title.
      theRect;8=contrlRectPtr&
      LONG IF PEEK([theControl&]+_contrlTitle+1)<>13
        'if the control title does NOT start with a return, then do the normal above-rect thing.
        theRect.top%=theRect.top%-(USR FONTHEIGHT+1)
        theRect.bottom%=theRect.top%+USR FONTHEIGHT-1
      XELSE
        theRect.top%=theRect.bottom%
        theRect.bottom%=theRect.top%+USR FONTHEIGHT'position below the slider bar
      END IF
      valueText$=STR$(theControl&..contrlValue%)
      theRect.left%=theRect.right%-(FN STRINGWIDTH(valueText$)+2)
  END SELECT

  'now copy our calculated rectangle into the destination
  BLOCKMOVE @theRect,destRectPtr&,8
END FN

CLEAR LOCAL MODE
DIM theRect.8,contrlRect.8
DIM handleOffset%
DIM 7 valueText$
LOCAL FN calcVertRect(theControl&,contrlRectPtr&,destRectPtr&,whichRect%)
  contrlRect;8=contrlRectPtr&
  SELECT whichRect%
    CASE _handleWideFrame                         'the wide part of the draggable handle
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.top%+_handleEdgeOffset
      theRect.bottom%=theRect.top%+_handleWideWidth
      INC(theRect.left%):DEC(theRect.right%)
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,theControl&..contrlValue%,_vert)
      CALL OFFSETRECT(theRect.top%,0,handleOffset%)
    CASE _handleTallFrame                         'the long, thin part of the handle
      theRect;8=contrlRectPtr&
      theRect.top%=theRect.top%+_handleTallEdgeOffset
      theRect.bottom%=theRect.top%+_handleTallWidth
      handleOffset%=FN handleOffset(theControl&,contrlRectPtr&,theControl&..contrlValue%,_vert)
      CALL OFFSETRECT(theRect.top%,0,handleOffset%)
    CASE _barOutsideFrame
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.left%+_edgeOffset
      theRect.right%=theRect.right%-_edgeOffset
    CASE _barInsideFrame
      theRect;8=contrlRectPtr&
      CALL INSETRECT(theRect.top%,8,2)
    CASE _barFill
      theRect;8=contrlRectPtr&
      CALL INSETRECT(theRect.top%,9,3)
    CASE _barClear1
      theRect;8=contrlRectPtr&
      theRect.right%=theRect.left%+_edgeOffset
    CASE _barClear2
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.right%-_edgeOffset
    CASE _fillClear1
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.left%+_fillClearOffset
      theRect.right%=theRect.left%+1
      theRect.top%=theRect.top%+_handleEdgeOffset
      theRect.bottom%=theRect.bottom%-_handleEdgeOffset
    CASE _fillClear2
      theRect;8=contrlRectPtr&
      theRect.left%=theRect.right%-_fillClearOffset-1
      theRect.right%=theRect.left%+1
      theRect.top%=theRect.top%+_handleEdgeOffset
      theRect.bottom%=theRect.bottom%-_handleEdgeOffset
    CASE _titleText                               'box for the control title to go in
      'this depends on whether the control title starts with a return character or not. If it does, that
      'means the title is supposed to go underneath the slider bar. If not, it means the title is above
      'the slider bar, as normal.
      theRect;8=contrlRectPtr&
      LONG IF PEEK([theControl&]+_contrlTitle+1)<>13
        'if the control does NOT start with a return, then do the normal above-rect thing.
        theRect.top%=theRect.top%-(USR FONTHEIGHT+1)
        theRect.bottom%=theRect.top%+USR FONTHEIGHT-1
      XELSE
        theRect.top%=theRect.bottom%
        theRect.bottom%=theRect.top%+USR FONTHEIGHT'position below the slider bar
      END IF
      theRect.left%=theControl&..contrlRect.left%
      theRect.right%=theRect.left%+FN STRINGWIDTH(theControl&..contrlTitle$)+2
    CASE _valueText
      'this is used to draw the control's current value on the right side of the slider title.
      theRect;8=contrlRectPtr&
      LONG IF PEEK([theControl&]+_contrlTitle+1)<>13
        'if the control title does NOT start with a return, then do the normal above-rect thing.
        theRect.top%=theRect.top%-(USR FONTHEIGHT+1)
        theRect.bottom%=theRect.top%+USR FONTHEIGHT-1
      XELSE
        theRect.top%=theRect.bottom%
        theRect.bottom%=theRect.top%+USR FONTHEIGHT'position below the slider bar
      END IF
      valueText$=STR$(theControl&..contrlValue%)
      theRect.right%=theControl&..contrlRect.right%
      theRect.left%=theRect.right%-(FN STRINGWIDTH(valueText$)+2)
  END SELECT

  'now copy the newly-calculated rectangle into its destination
  BLOCKMOVE @theRect,destRectPtr&,8
END FN

LOCAL FN calcRect(theControl&,@contrlRectPtr&,@destRectPtr&,whichRect%,orient%)
  'function just switches between the above two functions, depending on the value of orient%.
  IF orient%=_horz THEN FN calcHorzRect(theControl&,contrlRectPtr&,destRectPtr&,whichRect%) ELSE FN calcVertRect(theControl&,contrlRectPtr&,destRectPtr&,whichRect%)
END FN

CLEAR LOCAL MODE
DIM cntrlRect.8
DIM centerRect.8                                  'stores the centered, sized version of the control
DIM tempRect.8                                    'scratchpad for calculating rectangles

DIM tempRgn&
DIM orient%                                       'which way is this thing oriented?

DIM oldPenState.26,oldForeColor.RGBColor,oldBackColor.RGBColor
DIM oldText.8                                     'storage for old text settings
DIM pixelDepth%
LOCAL FN calcCtrlRgns(theControl&,destRgn&,varCode%)
  'calculates a shape for the outline of the slider (to trap clicks with)

  cntrlRect;8=[theControl&]+_contrlRect

  tempRgn&=FN NEWRGN
  LONG IF tempRgn&<>_nil AND destRgn&<>_nil

    oldText;8=[[theControl&]+_contrlOwner]+_txFont'save current text settings
    FN skoogieRectForTitle(theControl&,@cntrlRect.top%,varCode% AND _useWFont)

    'next, we need to adjust the rectangles to fit the control correctly
    LONG IF cntrlRect.right%-cntrlRect.left% > cntrlRect.bottom%-cntrlRect.top%
      'if the control is bigger horizontally, then draw it horizontally.
      centerRect;8=@cntrlRect.top%
      centerRect.bottom%=centerRect.top%+_fixedSize'the fixed direction is vertical, in this case
      CALL OFFSETRECT(centerRect.top%,0,(cntrlRect.bottom%-centerRect.bottom%)/2)'center it vertically
      orient%=_horz
    XELSE
      'the control is not bigger horizontally, so make it a vertical control.
      centerRect;8=@cntrlRect.top%
      centerRect.right%=centerRect.left%+_fixedSize
      CALL OFFSETRECT(centerRect.top%,(cntrlRect.right%-centerRect.right%)/2,0)'center horizontally
      orient%=_vert
    END IF

    'we need to calculate exactly three roundrects: the slider bar, the wide handle, and the tall handle.

    'first put the wide handle into the dest rgn
    FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleWideFrame,orient%)
    CALL OPENRGN
    CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
    CALL CLOSERGN(tempRgn&)                       'we've saved the region for the wide handle rect
    CALL UNIONRGN(destRgn&,tempRgn&,destRgn&)     'put the wide handle into the destination

    'second thing: exclude the tall handle from the clip region also
    FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleTallFrame,orient%)
    CALL OPENRGN
    CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
    CALL CLOSERGN(tempRgn&)
    CALL UNIONRGN(destRgn&,tempRgn&,destRgn&)     'add the tall handle to the destination

    'last thing: do the roundrect fro the slider body
    FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barOutsideFrame,orient%)
    CALL OPENRGN
    LONG IF orient%=_horz
      CALL FRAMEROUNDRECT(tempRect.top%,_outsideRoundMajor,_outsideRoundMinor)
    XELSE
      CALL FRAMEROUNDRECT(tempRect.top%,_outsideRoundMinor,_outsideRoundMajor)
    END IF
    CALL CLOSERGN(tempRgn&)
    CALL UNIONRGN(destRgn&,tempRgn&,destrgn&)     'mix it into the destination region

    'and dispose of the temprgn:
    CALL DISPOSERGN(tempRgn&)
  END IF

END FN

CLEAR LOCAL MODE
DIM cntrlRect.8,oldClip&
DIM centerRect.8                                  'stores the centered, sized version of the control
DIM tempRect.8                                    'scratchpad for calculating rectangles
DIM tempClip&,mixClip&

DIM orient%                                       'which way is this thing oriented?

DIM 7 valueText$                                  'string that contains the current value of the control
DIM titleRightSide%                               'for erasing above the slider bar to eliminate extra characters from the value display

DIM oldPenState.26,oldForeColor.RGBColor,oldBackColor.RGBColor
DIM oldText.8                                     'save old font, size, style, and mode in this block
DIM pixelDepth%
LOCAL FN drawControl(theControl&,varCode%)
  'simply draws the control's picture, hilited or non-hilited....
  LONG IF PEEK([theControl&]+_contrlVis)
    'only draw the control if it is actually visible

    cntrlRect;8=[theControl&]+_contrlRect
    pixelDepth%=FN getPixelDepth(cntrlRect.top%)

    oldClip&=FN NEWRGN
    tempClip&=FN NEWRGN
    mixClip&=FN NEWRGN                            'two regions for making the total clip region
    LONG IF oldClip&<>_nil AND tempClip&<>_nil AND mixClip&<>_nil
      CALL GETCLIP(oldClip&)                      'save the old clip region - we are going to mask drawing to the control rectangle
      CALL CLIPRECT(cntrlRect)                    'only allow drawing within the slider control
      CALL GETPENSTATE(oldPenState)               'save pen state, so we don't screw the program up while working
      LONG IF pixelDepth%>1
        CALL GETFORECOLOR(oldForeColor.red%)
        CALL GETBACKCOLOR(oldBackColor.red%)
      END IF
      oldText;8=[[theControl&]+_contrlOwner]+_txFont'save the current text settings
      CALL PENNORMAL

      'now, if we have a control title, there's some stuff we need to do. Skoogie the control rectangle
      'to fit the text above or below it:
      FN skoogieRectForTitle(theControl&,@cntrlRect.top%,varCode% AND _useWFont)

      'next, we need to adjust the rectangles to fit the control correctly
      LONG IF cntrlRect.right%-cntrlRect.left% > cntrlRect.bottom%-cntrlRect.top%
        'if the control is bigger horizontally, then draw it horizontally.
        centerRect;8=@cntrlRect.top%
        centerRect.bottom%=centerRect.top%+_fixedSize'the fixed direction is vertical, in this case
        CALL OFFSETRECT(centerRect.top%,0,(cntrlRect.bottom%-centerRect.bottom%)/2)'center it vertically
        orient%=_horz
      XELSE
        'the control is not bigger horizontally, so make it a vertical control.
        centerRect;8=@cntrlRect.top%
        centerRect.right%=centerRect.left%+_fixedSize
        CALL OFFSETRECT(centerRect.top%,(cntrlRect.right%-centerRect.right%)/2,0)'center horizontally
        orient%=_vert
      END IF

      'also need to draw the text title for this slider
      LONG IF PEEK([theControl&]+_contrlTitle)>0
        FN calcRect(theControl&,centerRect.top%,tempRect.top%,_titleText,orient%)
        IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_titleText)
        CALL MOVETO(tempRect.left%,tempRect.bottom%)
        CALL DRAWSTRING(theControl&..contrlTitle$)

        'now something for the next function, which draws the control value - we must save the
        'right edge of the rectangle for this text.
        titleRightSide%=tempRect.right%
      END IF

      'and the current value of the control, if that option is set
      LONG IF (varCode% AND _drawValueText)<>_nil
        FN calcRect(theControl&,centerRect.top%,tempRect.top%,_valueText,orient%)
        IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_valueText)
        CALL MOVETO(tempRect.left%,tempRect.bottom%)
        valueText$=STR$(theControl&..contrlValue%)
        CALL DRAWSTRING(valueText$)

        'now we must erase the left-over junk from the last title and value, if necessary...
        tempRect.right%=tempRect.left%
        tempRect.left%=titleRightSide%
        CALL ERASERECT(tempRect.top%)
      END IF



      'okay, now calculate all the rectangles and draw them.
      'First task is to draw the slider handle.
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_handleWideFrame)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleWideFrame,orient%)
      CALL ERASEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
      CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_handleTallFrame)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleTallFrame,orient%)
      CALL ERASEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
      CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)

      'The slider handle is now drawn. Set up the clip region so the handle is excluded from it,
      'so we can now draw the slider bar etc. without flickering.
      CALL RECTRGN(tempClip&,centerRect.top%)     'set it to the full control box
      'first thing: exclude the wide handle thing from the clip region
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleWideFrame,orient%)
      CALL OPENRGN
      CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
      CALL CLOSERGN(mixClip&)                     'we've saved the region for the wide handle rect
      CALL DIFFRGN(tempClip&,mixClip&,tempClip&)  'subtract the mix clip from the temp clip
      'second thing: exclude the tall handle from the clip region also
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_handleTallFrame,orient%)
      CALL OPENRGN
      CALL FRAMEROUNDRECT(tempRect.top%,_handleRound,_handleRound)
      CALL CLOSERGN(mixClip&)
      CALL DIFFRGN(tempClip&,mixClip&,tempClip&)  'subtract the mix from the temp clip
      'The new clip region is prepared. Now set it to the window's clip:
      CALL SETCLIP(tempClip&)

      'if the appropriate varcode is set, then draw the tick marks:
      LONG IF (varCode% AND _drawTickMarks)<>_nil
        IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_tickMarks)
        FN drawTickMarks(theControl&,centerRect.top%,orient%)
        'now exclude the tickmarks from the rest of the drawing:
        CALL OPENRGN
        FN drawTickMarks(theControl&,centerRect.top%,orient%)
        CALL CLOSERGN(mixClip&)                   'save it as mixclip
        CALL DIFFRGN(tempClip&,mixClip&,tempClip&)'subtract it from the temp clip rgn
        CALL SETCLIP(tempClip&)                   'now set it to the window clip region
      END IF

      'We now begin to draw the slider body.
      'first do the outer frame:
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_barOutsideFrame)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barOutsideFrame,orient%)
      LONG IF orient%=_horz
        CALL FRAMEROUNDRECT(tempRect.top%,_outsideRoundMajor,_outsideRoundMinor)
      XELSE
        CALL FRAMEROUNDRECT(tempRect.top%,_outsideRoundMinor,_outsideRoundMajor)
      END IF
      'next do the inner frame & fill:
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_barInsideFrame)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barInsideFrame,orient%)
      LONG IF orient%=_horz
        CALL FRAMEROUNDRECT(tempRect.top%,_insideRoundMajor,_insideRoundMinor)
      XELSE
        CALL FRAMEROUNDRECT(tempRect.top%,_insideRoundMinor,_insideRoundMajor)
      END IF
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_barFill)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barFill,orient%)
      FN setGrayPattern
      LONG IF orient%=_horz
        CALL PAINTROUNDRECT(tempRect.top%,_insideRoundMajor,_insideRoundMinor)
      XELSE
        CALL PAINTROUNDRECT(tempRect.top%,_insideRoundMinor,_insideRoundMajor)
      END IF


      'finally, erase whatever remnants of the old slider handle picture stuck out over the edge
      'of the main slider bar:
      IF pixelDepth%>1 THEN FN setPartColor(theControl&,oldForeColor.red%,oldBackColor.red%,varCode%,_barClear1)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barClear1,orient%)
      CALL ERASERECT(tempRect.top%)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_barClear2,orient%)
      CALL ERASERECT(tempRect.top%)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_fillClear1,orient%)
      CALL ERASERECT(tempRect.top%)
      FN calcRect(theControl&,centerRect.top%,tempRect.top%,_fillClear2,orient%)
      CALL ERASERECT(tempRect.top%)

      'and dispose of the two temporary regions:
      CALL DISPOSERGN(tempClip&)
      CALL DISPOSERGN(mixClip&)
      CALL SETCLIP(oldClip&)
      CALL SETPENSTATE(oldPenState)
      BLOCKMOVE @oldText,[[theControl&]+_contrlOwner]+_txFont,8
      'restore the original font, size, style, and mode of the control's owning port.
      LONG IF pixelDepth%>1
        CALL RGBFORECOLOR(oldForeColor.red%)
        CALL RGBBACKCOLOR(oldBackColor.red%)
      END IF
      CALL DISPOSERGN(oldClip&)                   'trash the old clip region now that we're done storing it
    END IF

  END IF
END FN

CLEAR LOCAL MODE
DIM clicked%
DIM orient%,newValue%
DIM mouseOffset%
DIM mousePt.4,cntrlRect.8
DIM oldText.8,swapFont%                           'storage for the old text settings
LOCAL FN checkControlClick(theControl&,param&,varCode%)
  'function must check to see if the mouse is in the control. If so, it tracks clicks; otherwise, it just draws.
  mousePt;4=@param&
  IF FN EMPTYRGN(theControl&..contrlData&) THEN FN calcCtrlRgns(theControl&,theControl&..contrlData&,varCode%)
  cntrlRect;8=[theControl&]+_contrlRect
  IF cntrlRect.right%-cntrlRect.left% > cntrlRect.bottom%-cntrlRect.top% THEN orient%=_horz ELSE orient%=_vert

  oldText;8=[[theControl&]+_contrlOwner]+_txFont  'save the current text settings
  FN skoogieRectForTitle(theControl&,@cntrlRect.top%,varCode% AND _useWFont)

  LONG IF FN PTINRGN(mousePt.v%,theControl&..contrlData&)
    'is the mouse in the region? Goodie! This means it's time to slide this slider.

    WHILE FN BUTTON
      'just loop, tracking the control, until the mouse is let up.

      LONG IF orient%=_horz
        mouseOffset%=mousePt.h%-cntrlRect.left%-_handleEdgeOffset-(_handleWideWidth/2)
        newValue%=((theControl&..contrlMax%-theControl&..contrlMin%)*mouseOffset%) / (cntrlRect.right%-_handleEdgeOffset-cntrlRect.left%-_handleEdgeOffset-_handleWideWidth)
      XELSE
        mouseOffset%=(cntrlRect.bottom%-mousePt.v%-_handleEdgeOffset-(_handleWideWidth/2))
        newValue%=((theControl&..contrlMax%-theControl&..contrlMin%)*mouseOffset%) / (cntrlRect.bottom%-_handleEdgeOffset-cntrlRect.top%-_handleEdgeOffset-_handleWideWidth)
      END IF
      IF (mouseOffset%-FN handleOffset(theControl&,@cntrlRect,newValue%,orient%))>(FN handleOffset(theControl&,@cntrlRect,newValue%+1,orient%)-mouseOffset%) THEN INC(newValue%)
      'this tortuous-looking line checks to see if the mouse is closer to the next greater tick mark.
      'If it is closer, it increments the newvalue.
      IF newValue%<theControl&..contrlMin% THEN newValue%=theControl&..contrlMin%
      IF newValue%>theControl&..contrlMax% THEN newValue%=theControl&..contrlMax%
      'make sure the value stays within range there

      LONG IF newValue%<>theControl&..contrlValue%
        'if the control's value has changed, then redraw it & reset its value:
        theControl&..contrlValue%=newValue%
        FN drawControl(theControl&,varCode%)
      END IF

      CALL GETMOUSE(mousePt.v%)                   'get the mouse again, for the next cycle-through
    WEND
    clicked%=_inThumb                             'yes, this control was clicked.
  END IF

  BLOCKMOVE @oldText,[[theControl&]+_contrlOwner]+_txFont,8'restore original font settings

END FN=clicked%

"MainEntry"
DIM varCode%,theControl&,message%,param&,returnValue&
ENTERPROC%(varCode%,theControl&,message%,param&)

  returnValue&=_nil                               'reset the return code
  SELECT message%
      'what are we supposed to do? select & act accordingly
    CASE _drawCtlMsg
      FN drawControl(theControl&,varCode%)
    CASE _hitCtlMsg
      returnValue&=FN checkControlClick(theControl&,param&,varCode%)
    CASE _calcCtlMsg
      FN calcCtrlRgns(theControl&,param&,varCode%)
    CASE _newCtlMsg
      FN makeControlRegion(theControl&)
    CASE _dispCtlMsg
      FN killControlRegion(theControl&)
  END SELECT

EXITPROC%=returnValue&